home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / mee / vbdao / visdata / tblstru.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-10-06  |  16.9 KB  |  618 lines

  1. VERSION 2.00
  2. Begin Form fTblStru 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Table Structure"
  5.    ClientHeight    =   5550
  6.    ClientLeft      =   2100
  7.    ClientTop       =   1890
  8.    ClientWidth     =   5040
  9.    Height          =   5955
  10.    Icon            =   0
  11.    Left            =   2040
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   5550
  16.    ScaleWidth      =   5040
  17.    Top             =   1545
  18.    Width           =   5160
  19.    Begin TextBox cTableName 
  20.       BackColor       =   &H00FFFFFF&
  21.       Height          =   288
  22.       Left            =   1680
  23.       TabIndex        =   0
  24.       Tag             =   "OLS"
  25.       Top             =   120
  26.       Width           =   1932
  27.    End
  28.    Begin PictureBox IndexBox 
  29.       BackColor       =   &H00C0C0C0&
  30.       BorderStyle     =   0  'None
  31.       Height          =   1692
  32.       Left            =   0
  33.       ScaleHeight     =   1695
  34.       ScaleWidth      =   5055
  35.       TabIndex        =   9
  36.       Top             =   3720
  37.       Width           =   5052
  38.       Begin CommandButton PrintButton 
  39.          Caption         =   "&Print Structure"
  40.          Height          =   372
  41.          Left            =   720
  42.          TabIndex        =   14
  43.          Top             =   1320
  44.          Visible         =   0   'False
  45.          Width           =   1452
  46.       End
  47.       Begin CommandButton AddTableButton 
  48.          Caption         =   "&Build the Table"
  49.          Enabled         =   0   'False
  50.          Height          =   372
  51.          Left            =   720
  52.          TabIndex        =   8
  53.          Top             =   1320
  54.          Visible         =   0   'False
  55.          Width           =   1452
  56.       End
  57.       Begin CommandButton CloseButton 
  58.          Cancel          =   -1  'True
  59.          Caption         =   "&Close"
  60.          Height          =   372
  61.          Left            =   2880
  62.          TabIndex        =   3
  63.          Top             =   1320
  64.          Width           =   1452
  65.       End
  66.       Begin CommandButton AddIndexButton 
  67.          Caption         =   "Add &Index"
  68.          Height          =   252
  69.          Left            =   1200
  70.          TabIndex        =   5
  71.          Top             =   120
  72.          Width           =   1332
  73.       End
  74.       Begin CommandButton DelIndexButton 
  75.          Caption         =   "&Delete Index"
  76.          Height          =   252
  77.          Left            =   2640
  78.          TabIndex        =   6
  79.          Top             =   120
  80.          Width           =   1332
  81.       End
  82.       Begin Grid cIndexes 
  83.          Cols            =   4
  84.          FixedCols       =   0
  85.          Height          =   750
  86.          Left            =   120
  87.          TabIndex        =   2
  88.          Top             =   420
  89.          Width           =   4815
  90.       End
  91.       Begin Line Line1 
  92.          BorderWidth     =   5
  93.          X1              =   0
  94.          X2              =   4800
  95.          Y1              =   0
  96.          Y2              =   0
  97.       End
  98.       Begin Label IndexesLabel 
  99.          BackColor       =   &H00C0C0C0&
  100.          Caption         =   "Indexes:"
  101.          Height          =   252
  102.          Left            =   240
  103.          TabIndex        =   10
  104.          Top             =   120
  105.          Width           =   1092
  106.       End
  107.    End
  108.    Begin PictureBox FieldBox 
  109.       BackColor       =   &H00C0C0C0&
  110.       BorderStyle     =   0  'None
  111.       Height          =   2892
  112.       Left            =   0
  113.       ScaleHeight     =   2895
  114.       ScaleWidth      =   5055
  115.       TabIndex        =   11
  116.       Top             =   600
  117.       Width           =   5052
  118.       Begin CommandButton RemoveFieldButton 
  119.          Caption         =   "&Remove Field"
  120.          Height          =   252
  121.          Left            =   2625
  122.          TabIndex        =   7
  123.          Top             =   0
  124.          Width           =   1332
  125.       End
  126.       Begin CommandButton AddFieldButton 
  127.          Caption         =   "&Add Field"
  128.          Height          =   252
  129.          Left            =   1200
  130.          TabIndex        =   4
  131.          Top             =   0
  132.          Width           =   1332
  133.       End
  134.       Begin Grid cFields 
  135.          BackColor       =   &H00FFFFFF&
  136.          Cols            =   3
  137.          FixedCols       =   0
  138.          Height          =   2532
  139.          Left            =   120
  140.          TabIndex        =   1
  141.          Top             =   288
  142.          Width           =   4800
  143.       End
  144.       Begin Label FieldsLabel 
  145.          BackColor       =   &H00C0C0C0&
  146.          Caption         =   "Fields:"
  147.          Height          =   192
  148.          Left            =   240
  149.          TabIndex        =   12
  150.          Top             =   0
  151.          Width           =   732
  152.       End
  153.    End
  154.    Begin Label TableNameLabel 
  155.       BackColor       =   &H00C0C0C0&
  156.       Caption         =   "Table Name:"
  157.       Height          =   252
  158.       Left            =   360
  159.       TabIndex        =   13
  160.       Top             =   120
  161.       Width           =   1212
  162.    End
  163. Option Explicit
  164. Sub AddFieldButton_Click ()
  165.   MsgBar "Enter New Field Parameters, Press 'Close' when finished", False
  166.   fAddField.Show MODAL
  167.   MsgBar NULL_STR, False
  168. End Sub
  169. Sub AddIndexButton_Click ()
  170.   MsgBar "Enter New Index Parameters, Press 'Close' when finished", False
  171.   fIndexAdd.Show MODAL
  172.   MsgBar NULL_STR, False
  173. End Sub
  174. Sub AddTableButton_Click ()
  175.   Dim tbl As New TableDef
  176.   Dim fld As Field
  177.   Dim ind As Index
  178.   Dim i As Integer
  179.   Dim x As String
  180.   On Error GoTo ATErr
  181.   SetHourglass Me
  182.   MsgBar "Building New Table", True
  183.   tbl.Name = cTableName
  184.   'search to see if table exists
  185.   For i = 0 To gCurrentDB.TableDefs.Count - 1
  186.     If UCase(gCurrentDB.TableDefs(i).Name) = UCase(tbl.Name) Then
  187.       If MsgBox(tbl.Name & " already exists, delete it?", 4) = YES Then
  188.          gCurrentDB.TableDefs.Delete gCurrentDB.TableDefs(tbl.Name)
  189.       Else
  190.          ResetMouse Me
  191.          Exit Sub
  192.       End If
  193.       Exit For
  194.     End If
  195.   Next
  196.   'add the first field
  197.   cFields.Row = 1
  198.   cFields.Col = 0
  199.   If Len(cFields) = 0 Then
  200.     Beep
  201.     MsgBox "No Fields Defined!", 48
  202.     Exit Sub
  203.   End If
  204.   Set fld = New Field
  205.   fld.Name = cFields
  206.   cFields.Col = 1
  207.   fld.Type = GetFieldType((cFields))
  208.   If cFields = "Counter" Then
  209.     fld.Attributes = &H10   'counter type
  210.   End If
  211.   cFields.Col = 2
  212.   fld.Size = Val(cFields)
  213.   tbl.Fields.Append fld
  214.   gCurrentDB.TableDefs.Append tbl
  215.   'add the rest of the fields
  216.   For i = 2 To cFields.Rows - 1
  217.     Set fld = New Field
  218.     cFields.Row = i
  219.     cFields.Col = 0
  220.     fld.Name = cFields
  221.     cFields.Col = 1
  222.     fld.Type = GetFieldType((cFields))
  223.     If cFields = "Counter" Then
  224.       fld.Attributes = &H10   'counter type
  225.     End If
  226.     cFields.Col = 2
  227.     fld.Size = Val(cFields)
  228.     gCurrentDB.TableDefs(tbl.Name).Fields.Append fld
  229.   Next
  230.   'add the indexes
  231.   For i = 1 To cIndexes.Rows - 1
  232.     Set ind = New Index
  233.     cIndexes.Row = i
  234.     cIndexes.Col = 0
  235.     If Len(cIndexes) = 0 Then Exit For
  236.     ind.Name = cIndexes
  237.     cIndexes.Col = 1
  238.     ind.Fields = cIndexes
  239.     cIndexes.Col = 2
  240.     If cIndexes = "True" Then
  241.       ind.Unique = True
  242.     Else
  243.       ind.Unique = False
  244.     End If
  245.     cIndexes.Col = 3
  246.     If gstDataType = SQLDB Then
  247.       cIndexes = "N/A"
  248.     Else
  249.       If cIndexes = "True" Then
  250.         ind.Primary = True
  251.       Else
  252.         ind.Primary = False
  253.       End If
  254.     End If
  255.     gCurrentDB.TableDefs(tbl.Name).Indexes.Append ind
  256.   Next
  257.   RefreshTables fTables.cTableList, True
  258.   GoTo ATEnd
  259. ATErr:
  260.   ResetMouse Me
  261.   ShowError
  262.   Exit Sub
  263. ATEnd:
  264.   ResetMouse Me
  265.   MsgBar NULL_STR, False
  266.   Unload Me
  267. End Sub
  268. Sub cFields_DblClick ()
  269.    Dim f As New fDataBox
  270.    Dim erm As String
  271.    'only allowed on existing tables
  272.    If gfAddTableFlag = True Then
  273.      Exit Sub
  274.    End If
  275.    On Error GoTo FldPropErr
  276.    cFields.Row = cFields.SelStartRow
  277.    cFields.Col = 0
  278.    Set gCurrentField = gCurrentDB.TableDefs(fTables.cTableList).Fields(cFields)
  279.    f.caption = "Field Properties"
  280.    f.Tag = "FLD"
  281.    erm = "Name"
  282.    f.cData.AddItem "Name = " & gCurrentField.Name
  283.    erm = "Type"
  284.    f.cData.AddItem "Type = " & gCurrentField.Type
  285.    erm = "Size"
  286.    f.cData.AddItem "Size = " & gCurrentField.Size
  287.    erm = "SourceField"
  288.    f.cData.AddItem "SourceField = " & gCurrentField.SourceField
  289.    erm = "SourceTable"
  290.    f.cData.AddItem "SourceTable = " & gCurrentField.SourceTable
  291.    erm = "CollatingOrder"
  292.    f.cData.AddItem "CollatingOrder = " & gCurrentField.CollatingOrder
  293.    erm = "Attributes"
  294.    f.cData.AddItem "Attributes = &H" & Hex(gCurrentField.Attributes)
  295.    erm = "OrdinalPosition"
  296.    f.cData.AddItem "OrdinalPosition = " & gCurrentField.OrdinalPosition
  297.    f.Show MODAL
  298.   GoTo FldPropEnd
  299. FldPropErr:
  300.   f.cData.AddItem erm & ":" & Error$
  301.   Resume Next
  302. FldPropEnd:
  303. End Sub
  304. Sub cIndexes_DblClick ()
  305.    Dim f As New fDataBox
  306.    Dim erm As String
  307.    'only allowed on existing tables
  308.    If gfAddTableFlag = True Then
  309.      Exit Sub
  310.    End If
  311.    On Error GoTo IndPropErr
  312.    cIndexes.Row = cIndexes.SelStartRow
  313.    cIndexes.Col = 0
  314.    Set gCurrentIndex = gCurrentDB.TableDefs(fTables.cTableList).Indexes(cIndexes)
  315.    f.caption = "Field Properties"
  316.    f.Tag = "IND"
  317.    erm = "Name"
  318.    f.cData.AddItem "Name = " & gCurrentIndex.Name
  319.    erm = "Fields"
  320.    f.cData.AddItem "Fields = " & gCurrentIndex.Fields
  321.    erm = "Unique"
  322.    f.cData.AddItem "Unique Flag = " & stTrueFalse((gCurrentIndex.Unique))
  323.    erm = "Primary"
  324.    f.cData.AddItem "PrimaryFlag = " & stTrueFalse((gCurrentIndex.Primary))
  325.    f.Show MODAL
  326.   GoTo IndPropEnd
  327. IndPropErr:
  328.   f.cData.AddItem erm & ":" & Error$
  329.   Resume Next
  330. IndPropEnd:
  331. End Sub
  332. Sub CloseButton_Click ()
  333.   Unload Me
  334.   MsgBar NULL_STR, False
  335. End Sub
  336. Sub cTableName_Change ()
  337.   If Len(cTableName) = 0 Then
  338.     AddTableButton.Enabled = False
  339.   Else
  340.     AddTableButton.Enabled = True
  341.   End If
  342. End Sub
  343. Sub cTableName_KeyPress (KeyAscii As Integer)
  344.   If cTableName.TabStop = False Then
  345.     KeyAscii = 0   'throw away the key
  346.   End If
  347. End Sub
  348. Sub DelIndexButton_Click ()
  349.   On Error GoTo DELErr
  350.   cIndexes.Row = cIndexes.SelStartRow
  351.   cIndexes.Col = 0
  352.   If Len(cIndexes) = 0 Then Exit Sub
  353.   If MsgBox("Delete """ & cIndexes & """ index?", MSGBOX_TYPE) = YES Then
  354.     If gfAddTableFlag = False Then
  355.       gCurrentDB.TableDefs(fTables.cTableList).Indexes.Delete gCurrentDB.TableDefs(fTables.cTableList).Indexes(cIndexes)
  356.     End If
  357.     'refresh the list of indexes
  358.     If cIndexes.Rows = 2 Then
  359.       cIndexes.Col = 0
  360.       cIndexes = NULL_STR
  361.       cIndexes.Col = 1
  362.       cIndexes = NULL_STR
  363.       cIndexes.Col = 2
  364.       cIndexes = NULL_STR
  365.     Else
  366.       cIndexes.RemoveItem cIndexes.Row
  367.     End If
  368.   End If
  369.   Exit Sub
  370. DELErr:
  371.   ShowError
  372.   Exit Sub
  373. End Sub
  374. Sub Form_Load ()
  375.   Dim tbl As TableDef
  376.   Dim i As Integer
  377.   Dim s As String
  378.   On Error GoTo LoadErr
  379.   Width = 5160
  380.   Height = 5955
  381.   SetHourglass Me
  382.   fTables.MousePointer = HOURGLASS
  383.   MsgBar "Opening Design Form", True
  384.   fTblStru.cTableName.TabStop = gfAddTableFlag
  385.   'setup field grid titles
  386.   cFields.ColWidth(0) = 2500
  387.   cFields.ColWidth(1) = 1500
  388.   cFields.ColWidth(2) = 500
  389.   cFields.Row = 0
  390.   cFields.Col = 0
  391.   cFields = "Name"
  392.   cFields.Col = 1
  393.   cFields = "Type"
  394.   cFields.Col = 2
  395.   cFields = "Size"
  396.   'setup index grid titles
  397.   cIndexes.ColWidth(0) = 850
  398.   cIndexes.ColWidth(1) = 2250
  399.   cIndexes.ColWidth(2) = 650
  400.   cIndexes.ColWidth(3) = 700
  401.   cIndexes.Row = 0
  402.   cIndexes.Col = 0
  403.   cIndexes = "Name"
  404.   cIndexes.Col = 1
  405.   cIndexes = "Indexed Fields"
  406.   cIndexes.Col = 2
  407.   cIndexes = "Unique"
  408.   cIndexes.Col = 3
  409.   cIndexes = "Primary"
  410.   If gfAddTableFlag = True Then
  411.     caption = "Add Table"
  412.     AddTableButton.Visible = True
  413.     cFields.Rows = 2
  414.     cIndexes.Rows = 2
  415.   Else
  416.     caption = "View/Modify Structure"
  417.     PrintButton.Visible = True
  418.     RemoveFieldButton.Visible = False
  419.     fTblStru.cTableName = fTables.cTableList
  420.     Set tbl = gCurrentDB.TableDefs(fTables.cTableList)
  421.     cFields.Rows = tbl.Fields.Count + 1
  422.     For i = 1 To cFields.Rows - 1
  423.       cFields.Row = i
  424.       cFields.Col = 0
  425.       cFields = tbl.Fields(i - 1).Name
  426.       cFields.Col = 1
  427.       Select Case tbl.Fields(i - 1).Type
  428.         Case FT_TRUEFALSE
  429.           s = "True/False"
  430.         Case FT_BYTE
  431.           s = "Byte"
  432.         Case FT_INTEGER
  433.           s = "Integer"
  434.         Case FT_LONG
  435.           If tbl.Fields(i - 1).Attributes And &H10 = &H10 Then
  436.             s = "Counter"
  437.           Else
  438.             s = "Long"
  439.           End If
  440.         Case FT_CURRENCY
  441.           s = "Currency"
  442.         Case FT_SINGLE
  443.           s = "Single"
  444.         Case FT_DOUBLE
  445.           s = "Double"
  446.         Case FT_DATETIME
  447.           s = "Date/Time"
  448.         Case 9
  449.           s = "Reserved/9"
  450.         Case FT_STRING
  451.           s = "String"
  452.         Case FT_BINARY
  453.           s = "Binary"
  454.         Case FT_MEMO
  455.           s = "Memo"
  456.         Case Else
  457.           s = CStr(tbl.Fields(i - 1).Type)
  458.       End Select
  459.       cFields = s
  460.       cFields.Col = 2
  461.       cFields = CStr(tbl.Fields(i - 1).Size)
  462.     Next
  463.     If tbl.Indexes.Count = 0 Then
  464.       cIndexes.Rows = 2
  465.     Else
  466.       cIndexes.Rows = tbl.Indexes.Count + 1
  467.       For i = 1 To cIndexes.Rows - 1
  468.         cIndexes.Row = i
  469.         cIndexes.Col = 0
  470.         cIndexes = tbl.Indexes(i - 1).Name
  471.         cIndexes.Col = 1
  472.         cIndexes = tbl.Indexes(i - 1).Fields
  473.         cIndexes.Col = 2
  474.         If tbl.Indexes(i - 1).Unique = False Then
  475.           s = "False"
  476.         Else
  477.           s = "True"
  478.         End If
  479.         cIndexes = s
  480.         cIndexes.Col = 3
  481.         If gstDataType = SQLDB Then
  482.           s = "N/A"
  483.         Else
  484.           If tbl.Indexes(i - 1).Primary = False Then
  485.             s = "False"
  486.           Else
  487.             s = "True"
  488.           End If
  489.         End If
  490.         cIndexes = s
  491.       Next
  492.     End If
  493.   End If
  494.   'lock the titles row and set the selected cell
  495.   cFields.Row = 1
  496.   cFields.SelStartCol = 0
  497.   cFields.SelEndCol = 0
  498.   cFields.FixedRows = 1
  499.   cIndexes.Row = 1
  500.   cIndexes.SelStartCol = 0
  501.   cIndexes.SelEndCol = 0
  502.   cIndexes.FixedRows = 1
  503.   ResizeFieldGrid
  504.   GoTo LoadEnd
  505. LoadErr:
  506.   ResetMouse Me
  507.   fTables.MousePointer = DEFAULT_MOUSE
  508.   ShowError
  509.   Unload Me
  510.   MsgBar NULL_STR, False
  511.   Exit Sub
  512.   Resume LoadEnd
  513. LoadEnd:
  514.   ResetMouse Me
  515.   fTables.MousePointer = DEFAULT_MOUSE
  516.   MsgBar NULL_STR, False
  517.         
  518. End Sub
  519. Sub Form_Paint ()
  520.   Outlines Me
  521.   FieldBox.Refresh
  522.   PicOutlines FieldBox, cFields
  523.   IndexBox.Refresh
  524.   PicOutlines IndexBox, cIndexes
  525. End Sub
  526. Sub Form_Resize ()
  527.   On Error Resume Next
  528.   If WindowState <> 1 Then
  529.     If Width < 5190 Then
  530.       Width = 5190
  531.     End If
  532.     FieldBox.Width = Width ' - 350
  533.     cFields.Width = FieldBox.Width - 350
  534.     IndexBox.Width = Width ' - 350
  535.     cIndexes.Width = IndexBox.Width - 350
  536.     Line1.X2 = IndexBox.Width
  537.     Form_Paint
  538.   End If
  539. End Sub
  540. Sub PrintButton_Click ()
  541.   'this routine simply prints the currently
  542.   'selected table's definition
  543.   Dim i As Integer
  544.   Dim s As String
  545.   MsgBar "Printing Table Structure", True
  546.   Printer.Print
  547.   Printer.Print
  548.   Printer.Print
  549.   Printer.Print "DataBase: " & gstDBName
  550.   Printer.Print
  551.   Printer.Print
  552.   Printer.Print "Table Definition for " & cTableName
  553.   Printer.Print
  554.   Printer.Print
  555.   Printer.Print "Fields: (Name - Type - Size)"
  556.   Printer.Print String(60, "-")
  557.   For i = 1 To cFields.Rows - 1
  558.     cFields.Row = i
  559.     cFields.Col = 0
  560.     s = cFields & " - "
  561.     cFields.Col = 1
  562.     s = s + cFields & " - "
  563.     cFields.Col = 2
  564.     s = s + cFields
  565.     Printer.Print s
  566.   Next
  567.   Printer.Print
  568.   Printer.Print
  569.   Printer.Print "Index List (Name - Fields - Unique)"
  570.   Printer.Print String(60, "-")
  571.   For i = 1 To cIndexes.Rows - 1
  572.     cIndexes.Row = i
  573.     cIndexes.Col = 0
  574.     s = cIndexes & " - "
  575.     cIndexes.Col = 1
  576.     s = s + cIndexes & " - "
  577.     cIndexes.Col = 2
  578.     s = s + cIndexes
  579.     Printer.Print s
  580.   Next
  581.   Printer.NewPage
  582.   Printer.EndDoc
  583.   MsgBar NULL_STR, False
  584. End Sub
  585. Sub RemoveFieldButton_Click ()
  586.   On Error GoTo RFErr
  587.   cFields.Row = cFields.SelStartRow
  588.   cFields.Col = 0
  589.   If Len(cFields) = 0 Then Exit Sub
  590.   If MsgBox("Remove """ & cFields & """ field?", MSGBOX_TYPE) = YES Then
  591.     'refresh the list of indexes
  592.     If cFields.Rows = 2 Then
  593.       cFields.Col = 0
  594.       cFields = NULL_STR
  595.       cFields.Col = 1
  596.       cFields = NULL_STR
  597.       cFields.Col = 2
  598.       cFields = NULL_STR
  599.     Else
  600.       cFields.RemoveItem cFields.Row
  601.       ResizeFieldGrid
  602.     End If
  603.   End If
  604.   GoTo RFEnd
  605. RFErr:
  606.   ShowError
  607.   Resume RFEnd
  608. RFEnd:
  609. End Sub
  610. Sub ResizeFieldGrid ()
  611.   If cFields.Rows < 12 Then
  612.     cFields.Height = cFields.Rows * 245
  613.     FieldBox.Height = cFields.Height + 360
  614.     IndexBox.Top = FieldBox.Top + FieldBox.Height + 250
  615.     Height = IndexBox.Top + IndexBox.Height + 500
  616.   End If
  617. End Sub
  618.